Shareware Overload Trio 2

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / c7105.zip / RPTGRPS.TPX < prev next >

Wrap

Text File | 1994-03-02 | 63KB | 1,381 lines

#!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐ #!│ RptGrps.TPX │Version: 3007.105│ #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤ #!│Structure Type Description │ #!│──────────────────── ───────── ─────────────────────────────────────────│ #!│ReportDataDeclares GROUP │ #!│RptRedirectGroup GROUP │ #!│RptGetLookupRecords GROUP │ #!│RptGetRelatedRecords GROUP │ #!│PrintDetail GROUP │ #!│RptTotalRoutines GROUP │ #!│DoTallyTotals GROUP │ #!│DoResetTotals GROUP │ #!│TallyTotals GROUP │ #!│ResetTotals GROUP │ #!│SaveFooterFields GROUP │ #!│SaveFooterRoutine GROUP │ #!│SaveFooterAssigns GROUP │ #!│PrintFooterFields GROUP │ #!│PrintFooterRoutine GROUP │ #!│RestoreFooterFields GROUP │ #!│RestoreFooterRoutine GROUP │ #!│ReportFormulas GROUP │ #!│RptRecordFilter GROUP │ #!│GroupBreakNumber GROUP │ #!│PrimaryGroupBreak GROUP │ #!│FindGroupBreaks GROUP │ #!│SecondaryGroupBreak GROUP │ #!│BreakFooterRoutines GROUP │ #!│BreakHeaderRoutines GROUP │ #!│GroupBreakFooter GROUP │ #!│GroupBreakHeader GROUP │ #!│MultiUpLabelBuild GROUP │ #!│MultiUpLabelReset GROUP │ #!│PrintDanglingLabels GROUP │ #!│RptAbortKey GROUP │ #!│RptSetFlags GROUP │ #!│RptFindFile GROUP │ #!│ReportErrorCheck GROUP │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.102 Repaired %PrintFooterRoutine GROUP │ #!│ Repaired %PrintFooterFields GROUP │ #!│3007.103 Repaired %FindGroupBreaks GROUP │ #!│3007.105 Repaired %RptRedirectGroup GROUP │ #!│ Repaired %PrimaryGroupBreak GROUP │ #!│ Repaired %FindGroupBreaks GROUP │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #!*************************************************************************** #GROUP(%ReportDataDeclares) #!Internal data declarations TempFile CSTRING(65),AUTO #<!Temporary filename variable #IF(%RedirectProc AND %ViewProc) SavePath STRING(64),AUTO #<!Temporary path save variable TempPath STRING(64),AUTO #<!Temporary directory variable #ENDIF #FIX(%File,%Primary) %FilePre::PRINTED BYTE,AUTO #<!%Primary recs printed flag #FOR(%Secondary) #IF(%SecondaryType = '1:MANY') #FIX(%File,%Secondary) %FilePre::PRINTED BYTE,AUTO #<!%Secondary recs printed flag #ENDIF #ENDFOR #IF(%ReportGroupExist) BreakLevel BYTE,AUTO #<!Group break level flag #ENDIF #FOR(%ReportGroup) #!Group break fields #SET(%BreakField,%ReportGroup) #INSERT(%RptFindFile) #IF(%Primary = %FoundFile) #FIX(%File,%FoundFile) #FIX(%Key,%PrimaryKey) #ELSE #FIX(%Secondary,%FoundFile) #FIX(%File,%SecondaryTo) #FIX(%Relation,%Secondary) #SET(%TempKey,%RelationKey) #FIX(%File,%FoundFile) #FIX(%Key,%TempKey) #ENDIF #FOR(%KeyField) #!Build BreakFilesQueue #FIX(%Field,%KeyField) #! and declare group break #SET(%Temp,%KeyField) #! save fields at same time #IF(NOT INSTRING(%Temp,%BreakFieldsQueue,1,1)) #SET(%BreakFieldsQueue,(%BreakFieldsQueue & %Temp & ',')) #IF(%FieldType = 'GROUP') BRK::%KeyField STRING(SIZE(%KeyField)) #<!Group break save field #ELSE BRK::%KeyField LIKE(%KeyField) #<!Group break save field #ENDIF #ENDIF #IF(%KeyField = %ReportGroup) #!End of break fields #BREAK #! for this Group Break #ENDIF #ENDFOR #ENDFOR #SET(%Counter1,%NULL) #FOR(%ReportTotal) #!AVERAGE total fields #SET(%Counter1,(%Counter1 + 1)) #IF(%ReportTotalType = 'LOW') %ReportTotal::Reset BYTE(1) #ELSIF(%ReportTotalType = 'AVERAGE') #IF(INSTRING('[',%ReportTotalField,1,1)) #!Check for array element #SET(%ArrayField,(SUB(%ReportTotalField,1,INSTRING('[',%ReportTotalField,1,1)-1))) %ReportTotal::Cnt::%ArrayField::%Counter1 LONG #<!Average total count %ReportTotal::Sum::%ArrayField::%Counter1 REAL #<!Average total sum #ELSE %ReportTotal::Cnt::%ReportTotalField LONG #<!Average total count %ReportTotal::Sum::%ReportTotalField REAL #<!Average total sum #ENDIF #ENDIF #ENDFOR #IF(%ReportSaveExist) #SET(%Counter1,%NULL) #SET(%Counter2,%NULL) #FOR(%ReportSave) #!Footer save fields #SET(%Counter1,(%Counter1 + 1)) #FOR(%ReportSaveField) #SET(%Counter2,(%Counter2 + 1)) #SET(%BreakField,%ReportSaveField) #INSERT(%RptFindFile) #IF(INSTRING(%FoundFile,%SaveFilesQueue,1,1)) #IF(INSTRING('[',%ReportSaveField,1,1)) #!Check for array element #SET(%ArrayField,(SUB(%ReportSaveField,1,INSTRING('[',%ReportSaveField,1,1)-1))) #FIX(%File,%FoundFile) #FIX(%Field,%ArrayField) #IF(%FieldType = 'STRING' OR %FieldType = 'CSTRING' OR %FieldType = 'PSTRING') SAV1::%ReportSave::%Field::%Counter1::%Counter2 STRING(SIZE(%ReportSaveField)),AUTO SAV2::%ReportSave::%Field::%Counter1::%Counter2 STRING(SIZE(%ReportSaveField)),AUTO #<!%ReportSave Footer save fields #ELSE SAV1::%ReportSave::%Field::%Counter1::%Counter2 REAL,AUTO SAV2::%ReportSave::%Field::%Counter1::%Counter2 REAL,AUTO #<!%ReportSave Footer save fields #ENDIF #ELSE #FIX(%File,%FoundFile) #FIX(%Field,%ReportSaveField) #IF(%FieldType = 'GROUP') SAV1::%ReportSave::%ReportSaveField STRING(SIZE(%ReportSaveField)),AUTO SAV2::%ReportSave::%ReportSaveField STRING(SIZE(%ReportSaveField)),AUTO #<!%ReportSave Footer save fields #ELSE SAV1::%ReportSave::%ReportSaveField LIKE(%ReportSaveField),AUTO SAV2::%ReportSave::%ReportSaveField LIKE(%ReportSaveField),AUTO #<!%ReportSave Footer save fields #ENDIF #ENDIF #ENDIF #ENDFOR #ENDFOR #ENDIF #IF(%PageTotals = 'YES') SAV::LineCounter SHORT #<!Line counter save #ENDIF #IF(%ReportLabel) #!Multi-up label USE variables SAV::LabelCounter BYTE #<!Multi-up label counter #SET(%Counter1,%NULL) #FOR(%ReportLabelField) #SET(%Counter1,(%Counter1 + 1)) #IF(INSTRING('[',%ReportLabelField,1,1)) #!Check for array element #SET(%ArrayField,(SUB(%ReportLabelField,1,INSTRING('[',%ReportLabelField,1,1)-1))) #SET(%BreakField,%ReportLabelField) #INSERT(%RptFindFile) #FIX(%File,%FoundFile) #FIX(%Field,%ArrayField) #IF(%FieldType = 'STRING' OR %FieldType = 'CSTRING' OR %FieldType = 'PSTRING' OR %FieldType = 'GROUP') LBL::%ArrayField::%Counter1 STRING(SIZE(%ReportLabelField)),DIM(%ReportLabel) #<!%ReportLabelField Multi-up USE variable #ELSE LBL::%ArrayField::%Counter1 REAL,DIM(%ReportLabel) #<!%ReportLabelField Multi-up USE variable #ENDIF #ELSE #SET(%BreakField,%ReportLabelField) #INSERT(%RptFindFile) #FIX(%File,%FoundFile) #FIX(%Field,%ReportLabelField) #IF(%FieldType = 'GROUP') LBL::%ReportLabelField STRING(SIZE(%ReportLabelField)),DIM(%ReportLabel) #<!%ReportLabelField Multi-up USE variable #ELSE LBL::%ReportLabelField LIKE(%ReportLabelField),DIM(%ReportLabel) #<!%ReportLabelField Multi-up USE variable #ENDIF #ENDIF #ENDFOR #ENDIF #! #!*************************************************************************** #GROUP(%RptRedirectGroup) #!Runtime report redirection #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ RptRedirectGroup │Version: 3007.105│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Generates Report Redirection Code │ #!│Called From: Report Procedure │ #!│Assumptions: None │ #!│Inserts: PrinterOffLineMsg │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.105 Replaced RETURNs with DO ProcedureReturn │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #IF(%RedirectProc) %RedirectProc #<!Call redirection procedure CASE GLO:FileSpec #<!Detect redirection selection OF 'CANCEL' #<!Cancel report requested DO ProcedureReturn #IF(%ViewProc) OF 'SCREEN' #<!Screen view requested TempPath = COMMAND('CLATMP',0) #<!Get temporary file directory IF TempPath #<!CLATMP set? SavePath = PATH() #<!Save current path SETPATH(TempPath) #<!Set to temp file directory END LOOP #<!Create temporary filename X# += 1 #<! for screen report TempFile = 'RPT' & FORMAT(X#,@N05) & '.$$$' IF NOT Access(TempFile,0) THEN CYCLE ELSE BREAK. #<!Check existing file END IF TempPath #<!CLATMP set? IF SUB(CLIP(TempPath),-1,1) = '\' TempFile = CLIP(TempPath) & TempFile #<!Assign temporary filename ELSE TempFile = CLIP(TempPath) & '\' & TempFile #<!Assign temporary filename END SETPATH(SavePath) #<!Return to previous path END ReportDevice = TempFile GLO:FileSpec = TempFile #ELSE #!Redirect w/o View Proc OF 'SCREEN' #<!Screen view requested DO ProcedureReturn #<! w/o View Procedure #ENDIF ELSE #<!All other report devices ReportDevice = GLO:FileSpec #<! go to the device TempFile = SUB(LEFT(UPPER(GLO:FileSpec)),1,3) #<!Get first three characters IF (TempFile = 'LPT' OR TempFile = 'COM') AND NUMERIC(GLO:FileSpec[4]) IF TempFile = 'LPT' and NOT STATUS(GLO:FileSpec) #<!Check printer status #INSERT(%PrinterOffLineMsg) DO ProcedureReturn END GLO:FileSpec = '' #<!Disable viewing END TempFile = '' END #ELSIF(%ViewProc) #!View w/o Redirect Proc TempFile = SUB(LEFT(UPPER(%ReportDevice)),1,3) #<!Get first three characters IF (TempFile = 'LPT' OR TempFile = 'COM') AND NUMERIC(SUB(LEFT(%ReportDevice),4,1)) IF TempFile = 'LPT' and NOT STATUS(%ReportDevice) #<!Check printer status #INSERT(%PrinterOffLineMsg) DO ProcedureReturn END GLO:FileSpec = '' #<!Disable viewing ELSE GLO:FileSpec = ReportDevice #<!Set up filename for %ViewProc END #<! port selections TempFile = '' #ELSE #!No View or Redirect Proc TempFile = SUB(LEFT(UPPER(%ReportDevice)),1,3) #<!Get first three characters IF (TempFile = 'LPT' OR TempFile = 'COM') AND NUMERIC(SUB(LEFT(%ReportDevice),4,1)) IF TempFile = 'LPT' and NOT STATUS(%ReportDevice) #<!Check printer status #INSERT(%PrinterOffLineMsg) DO ProcedureReturn END END #<! port selections TempFile = '' #ENDIF #! #!*************************************************************************** #GROUP(%RptGetLookupRecords) #!Get all lookup records #FOR(%Secondary) #!%GetLookupFrom must be set #IF(%SecondaryTo = %GetLookupFrom) #! before #INSERT of this group #IF(%SecondaryType = 'MANY:1') #!Check for Lookup files #FIX(%File,%SecondaryTo) #FIX(%Relation,%Secondary) #FOR(%RelationKeyField) %RelationKeyField = %RelationKeyFieldLink #<!Assign linking field value #ENDFOR GET(%Secondary,%RelationKey) #<!Lookup record #FIX(%File,%Secondary) IF ERRORCODE() THEN CLEAR(%FilePre:Record). #<!Clear record if unsuccessful #IF(%ReportSaveExist) #SET(%SaveFile,%Secondary) #!Check for footer save fields #INSERT(%SaveFooterFields) #ENDIF #SET(%Temp,%GetLookupFrom) #!Push GetLookupFrom files #IF(NOT INSTRING(%Temp,%LookupFromQueue,1,1)) #SET(%LookupFromQueue,(%Temp & ',' & %LookupFromQueue)) #ENDIF #SET(%GetLookupFrom,%Secondary) #!Set up for next level #INSERT(%RptGetLookupRecords) #! and recursively get lookups #SET(%GetLookupFrom,(SUB(%LookupFromQueue,1,INSTRING(',',%LookupFromQueue,1,1)-1))) #SET(%LookupFromQueue,(SUB(%LookupFromQueue,LEN(%Temp)+2,LEN(%LookupFromQueue)-LEN(%Temp)+1))) #!Pop GetLookupFrom files #ENDIF #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%RptGetRelatedRecords) #!Get all related records #FOR(%Secondary) #!%Parent must be set #IF(%SecondaryTo=%Parent) #! before #INSERT of this group #IF(%SecondaryType = '1:MANY') #!Check for children files #FIX(%File,%Secondary) #SET(%GroupBreakOnFile,%Null) #SET(%GroupBreakCounter,%Null) #FOR(%ReportGroup) #FIX(%Field,%ReportGroup) #SET(%GroupBreakCounter,(%GroupBreakCounter+1)) #IF(%Field) #SET(%GroupBreakOnFile,%Field) #BREAK #ENDIF #ENDFOR #FIX(%File,%Parent) #FIX(%Relation,%Secondary) #SET(%HoldRelationKey,%RelationKey) #FIX(%File,%Relation) #FIX(%Key,%HoldRelationKey) #FOR(%KeyField) #SET(%LastSequence,%KeyFieldSequence) #ENDFOR #IF(%LastSequence='ASCENDING') CLEAR(%RelationPre:Record,-1) #ELSE CLEAR(%RelationPre:Record,1) #ENDIF #FIX(%File,%Parent) #FIX(%Relation,%Secondary) #FOR(%RelationKeyField) #IF(%RelationKeyFieldLink) %RelationKeyField = %RelationKeyFieldLink #<!Assign linking field value #ELSE #SET(%CurrentKeyField,%RelationKeyFieldLink) #SET(%BeginClearing,%Null) #FIX(%File,%Relation) #FIX(%Key,%HoldRelationKey) #FOR(%KeyField) #IF(%KeyField=%CurrentKeyField) #SET(%BeginClearing,'TRUE') #ENDIF #IF(%BeginClearing) #IF(%KeyFieldSequence='ASCENDING') CLEAR(%KeyField,-1) #<!Clear ASCENDING key field #ELSE CLEAR(%KeyField,1) #<!Clear DESCENDING key field #ENDIF #ENDIF #ENDFOR #BREAK #ENDIF #ENDFOR #FIX(%File,%Parent) #FIX(%Relation,%Secondary) %RelationPre::PRINTED = False #<!Set records printed flag SET(%RelationKey,%RelationKey) #<!Set to first related record LOOP #<!Loop through %Secondary NEXT(%Secondary) #<! getting each record IF ERRORCODE() THEN ErrEndFileFlag# = 1 ELSE ErrEndFileFlag# = 0. #<!Flag EOF #FIX(%File,%Secondary) #SET(%CodePosition,(%FilePre&':FILTER')) #INSERT(%RptRecordFilter) #SET(%GetLookupFrom,%Secondary) #INSERT(%RptGetLookupRecords) #!Get all Lookup records #SET(%CodePosition,%Secondary) #!Class = primary file #INSERT(%ReportFormulas) #!Generate formulas #IF(%GroupBreakOnFile) #IF(%ReportSaveExist) #SET(%SaveFile,%Secondary) #!Check for footer save fields #INSERT(%SaveFooterFields) #ENDIF #INSERT(%SecondaryGroupBreak) #ELSE #!No group break on this file #IF(%ReportSaveExist) #SET(%SaveFile,%Secondary) #!Check for footer save fields #INSERT(%SaveFooterFields) #ENDIF #SET(%IfWritten,%Null) #FOR(%RelationKeyField) #IF(%RelationKeyFieldLink) #IF(%IfWritten) OR %RelationKeyField <> %RelationKeyFieldLink | #<!Past related records? #ELSE IF %RelationKeyField <> %RelationKeyFieldLink | #SET(%IfWritten,'TRUE') #ENDIF #ELSE #BREAK #ENDIF #ENDFOR #IF(%IfWritten) OR ErrEndFileFlag# #<! or EOF? #ELSE IF ErrEndFileFlag# #<! or EOF? #ENDIF BREAK #<!Break loop END #FIX(%File,%Secondary) #SET(%CodePosition,(%FilePre&':FILTER')) #INSERT(%RptRecordFilter) #SET(%GetLookupFrom,%Secondary) #INSERT(%RptGetLookupRecords) #!Get all Lookup records #SET(%CodePosition,%Secondary) #!Class = primary file #INSERT(%ReportFormulas) #!Generate formulas #ENDIF #SET(%Parent,%Secondary) #!Recursive call to this group #INSERT(%RptGetRelatedRecords) #! to get next level deep #IF(%DetailPrinted <> 'PRINTED') #!If at lowest recursion level #INSERT(%PrintDetail) #! insert PRINT(Rpt:Detail) #INSERT(%RptAbortKey) #! and ESC key abort loop #SET(%DetailPrinted,'PRINTED') #!Set detail printed flag #ENDIF END #<!End %Secondary File Loop #ENDIF #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%PrintDetail) #IF(%ReportLabel) #INSERT(%MultiUpLabelBuild) #ENDIF #SET(%TallyType,'ALL') #!For totals on ALL #INSERT(%TallyTotals) #!Tally total fields #IF(%ReportDetailPre) %ReportDetailPre #ENDIF #IF(%ReportDetail) PRINT(%ReportPre:%ReportDetail) #<!Print line item detail #ENDIF #IF(%ProgressScreen) DISPLAY #<!Display report progress #ENDIF #IF(%ReportDetailPost) %ReportDetailPost #ENDIF #IF(%PageTotals) #!Any page total fields? IF SAV::LineCounter > %ReportLine #<!Page overflow occurred? #SET(%ResetTotalType,'PAGE') #!Reset page totals #INSERT(%ResetTotals) #SET(%TallyType,'PAGE') #!Tally page totals #INSERT(%TallyTotals) END SAV::LineCounter = %ReportLine #<!Save page overflow detect #ENDIF #IF(%ReportLabel) #INSERT(%MultiUpLabelReset) #ENDIF #! #!*************************************************************************** #GROUP(%RptTotalRoutines) #!Total field routines #FOR(%ReportTotal) #IF(%ReportTotalTally = 'PAGE') Tally::PAGE::Totals ROUTINE #<!Tallys on page break #SET(%TallyType,'PAGE') #INSERT(%DoTallyTotals) #BREAK #ENDIF #ENDFOR #FOR(%ReportTotal) #IF(%ReportTotalTally = 'ALL') Tally::ALL::Totals ROUTINE #<!Tallys on body detail #SET(%TallyType,'ALL') #INSERT(%DoTallyTotals) #BREAK #ENDIF #ENDFOR #FOR(%ReportGroup) #FOR(%ReportTotal) #IF(%ReportTotalTally = %ReportGroup) Tally::%ReportTotalTally::Totals ROUTINE #<!Tallys on group break #SET(%TallyType,%ReportTotalTally) #INSERT(%DoTallyTotals) #BREAK #ENDIF #ENDFOR #ENDFOR #FOR(%ReportTotal) #IF(%ReportTotalReset = 'PAGE') Reset::PAGE::Totals ROUTINE #<!Resets on page break #SET(%ResetTotalType,'PAGE') #INSERT(%DoResetTotals) #BREAK #ENDIF #ENDFOR #FOR(%ReportTotal) #IF(%ReportTotalReset = 'NONE') Reset::NONE::Totals ROUTINE #<!Resets on report close #SET(%ResetTotalType,'NONE') #INSERT(%DoResetTotals) #BREAK #ENDIF #ENDFOR #FOR(%ReportGroup) #FOR(%ReportTotal) #IF(%ReportTotalReset = %ReportGroup) Reset::%ReportTotalReset::Totals ROUTINE #<!Resets on group break #SET(%ResetTotalType,%ReportTotalReset) #INSERT(%DoResetTotals) #BREAK #ENDIF #ENDFOR #ENDFOR #! #!*************************************************************************** #GROUP(%DoTallyTotals) #!Tally total fields #SET(%Counter1,%NULL) #!%TallyType must be set #FOR(%ReportTotal) #! before #INSERT this group #SET(%Counter1,(%Counter1 + 1)) #IF(%ReportTotalTally = %TallyType) #IF(%ReportTotalType = 'SUM') %ReportPre:%ReportTotal += %ReportTotalField #<!SUM total of %ReportTotalField #ELSIF(%ReportTotalType = 'COUNT') %ReportPre:%ReportTotal += 1 #<!COUNT total of %ReportTotalField #ELSIF(%ReportTotalType = 'HIGH') IF %ReportTotalField > %ReportPre:%ReportTotal #<!HIGH value of %ReportTotalField %ReportPre:%ReportTotal = %ReportTotalField END #ELSIF(%ReportTotalType = 'LOW') IF %ReportTotal::Reset %ReportTotal::Reset = False %ReportPre:%ReportTotal = %ReportTotalField ELSE IF %ReportTotalField < %ReportPre:%ReportTotal #<!LOW value of %ReportTotalField %ReportPre:%ReportTotal = %ReportTotalField END END #ELSIF(%ReportTotalType = 'AVERAGE') #IF(INSTRING('[',%ReportTotalField,1,1)) #!Check for array element #SET(%ArrayField,(SUB(%ReportTotalField,1,INSTRING('[',%ReportTotalField,1,1)-1))) %ReportTotal::Cnt::%ArrayField::%Counter1 += 1 #<!AVERAGE of %ReportTotalField %ReportTotal::Sum::%ArrayField::%Counter1 += %ReportTotalField %ReportPre:%ReportTotal = %ReportTotal::Sum::%ArrayField::%Counter1 / %ReportTotal::Cnt::%ArrayField::%Counter1 #ELSE %ReportTotal::Cnt::%ReportTotalField += 1 #<!AVERAGE of %ReportTotalField %ReportTotal::Sum::%ReportTotalField += %ReportTotalField %ReportPre:%ReportTotal = %ReportTotal::Sum::%ReportTotalField / %ReportTotal::Cnt::%ReportTotalField #ENDIF #ENDIF #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%DoResetTotals) #!Reset total fields #SET(%Counter1,%NULL) #!%ResetTotalType must be set #FOR(%ReportTotal) #! before #INSERT this group #SET(%Counter1,(%Counter1 + 1)) #IF(%ReportTotalReset = %ResetTotalType) %ReportPre:%ReportTotal = 0 #IF(%ReportTotalType = 'LOW') %ReportTotal::Reset = True #ENDIF #IF(%ReportTotalType = 'AVERAGE') #IF(INSTRING('[',%ReportTotalField,1,1)) #!Check for array element #SET(%ArrayField,(SUB(%ReportTotalField,1,INSTRING('[',%ReportTotalField,1,1)-1))) %ReportTotal::Cnt::%ArrayField::%Counter1 = 0 %ReportTotal::Sum::%ArrayField::%Counter1 = 0 #ELSE %ReportTotal::Cnt::%ReportTotalField = 0 %ReportTotal::Sum::%ReportTotalField = 0 #ENDIF #ENDIF #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%TallyTotals) #!Tally total fields #FOR(%ReportTotal) #!%TallyType must be set #IF(%ReportTotalTally = %TallyType) #! before #INSERT this group DO Tally::%TallyType::Totals #<!Tally %TallyType totals #BREAK #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%ResetTotals) #!Reset total fields #FOR(%ReportTotal) #!%ResetTotalType must be set #IF(%ReportTotalReset = %ResetTotalType) #! before #INSERT this group DO Reset::%ResetTotalType::Totals #<!Reset %ResetTotalType totals #BREAK #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%SaveFooterFields) #!Call footer save routines #FOR(%ReportSave) #!%SaveFile must be set #FOR(%ReportSaveField) #! before #INSERT this group #SET(%BreakField,%ReportSaveField) #INSERT(%RptFindFile) #IF(INSTRING(%FoundFile,%SaveFilesQueue,1,1)) #IF(%FoundFile = %SaveFile) #!Check for save file #FIX(%File,%SaveFile) DO Save::%FilePre::FooterFields #<!Save %SaveFile footer fields #SET(%Done,'YES') #BREAK #ELSE #SET(%Done,%NULL) #ENDIF #ENDIF #ENDFOR #IF(%Done = 'YES') #BREAK #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%SaveFooterRoutine) #!Rotate footer save fields #SET(%Temp,(SUB(%TempQueue,1,INSTRING(',',%TempQueue,1,1)-1))) #SET(%TempQueue,(SUB(%TempQueue,LEN(%Temp)+2,LEN(%TempQueue)-LEN(%Temp)+1))) #IF(%Temp) #FOR(%ReportSave) #IF(%ReportSave <> 'PAGE') #FOR(%ReportSaveField) #SET(%BreakField,%ReportSaveField) #INSERT(%RptFindFile) #IF(%Temp = %FoundFile) #FIX(%File,%FoundFile) Save::%FilePre::FooterFields ROUTINE #<!Save footer fields #SET(%SaveFile,%FoundFile) #INSERT(%SaveFooterAssigns) #SET(%GetAssigns,'YES') #BREAK #ELSE #SET(%GetAssigns,%NULL) #ENDIF #ENDFOR #ENDIF #IF(%GetAssigns) #BREAK #ENDIF #ENDFOR #INSERT(%SaveFooterRoutine) #ENDIF #! #!*************************************************************************** #GROUP(%SaveFooterAssigns) #!Rotate footer save fields #SET(%Counter1,%NULL) #SET(%Counter2,%NULL) #FOR(%ReportSave) #!%SaveFile must be set #SET(%Counter1,(%Counter1 + 1)) #FOR(%ReportSaveField) #! before #INSERT this group #IF(%ReportSaveField <> %ReportPage) #SET(%Counter2,(%Counter2 + 1)) #IF(INSTRING('[',%ReportSaveField,1,1)) #!Check for array element #SET(%ArrayField,(SUB(%ReportSaveField,1,INSTRING('[',%ReportSaveField,1,1)-1))) #ELSE #SET(%ArrayField,%NULL) #!Clear array flag #ENDIF #SET(%BreakField,%ReportSaveField) #INSERT(%RptFindFile) #FIX(%Secondary,%FoundFile) #IF(%FoundFile = %SaveFile) #IF(%ArrayField) #!Check for array element SAV2::%ReportSave::%ArrayField::%Counter1::%Counter2 = SAV1::%ReportSave::%ArrayField::%Counter1::%Counter2 SAV1::%ReportSave::%ArrayField::%Counter1::%Counter2 = %ReportSaveField #ELSE SAV2::%ReportSave::%ReportSaveField = SAV1::%ReportSave::%ReportSaveField SAV1::%ReportSave::%ReportSaveField = %ReportSaveField #ENDIF #ENDIF #ENDIF #ENDFOR #ENDFOR #! #!*************************************************************************** #GROUP(%PrintFooterFields) #!Set footer to print correct #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ PrintFooterFields │Version: 3007.102│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Generate DOs to routines that save report values │ #!│Called From: %GroupBreakFooter │ #!│Assumptions: That %WhichFooter contains the field that the break is on │ #!│Inserts: %RptFindFile (Find the file corresponding to a field) │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.102 Repaired ROUTINE name (was constructed as Print::%FilePre::... │ #!│ Should have been based on the Group Break name (%ReportSave). │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #FOR(%ReportSave) #! before #INSERT this group #IF(%ReportSave = %WhichFooter) #!Check for save file #SET(%BreakField,%ReportSave) #INSERT(%RptFindFile) #IF(INSTRING(%FoundFile,%SaveFilesQueue,1,1)) DO Print::%ReportSave::FooterFields #<!Print correct footer fields #BREAK #ENDIF #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%PrintFooterRoutine) #!Set footer to print correct #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ PrintFooterRoutine │Version: 3007.102│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Generate routines that save report values │ #!│Called From: Report #PROCEDURE │ #!│Assumptions: None │ #!│Inserts: %RptFindFile (Find the file corresponding to a field) │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.102 Repaired ROUTINE name (was constructed as Print::%FilePre::... │ #!│ Should have been based on the Group Break name (%ReportSave). │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #SET(%Counter1,%NULL) #! footer field values #SET(%Counter2,%NULL) #FOR(%ReportSave) #! before #INSERT this group #SET(%BreakField,%ReportSave) #INSERT(%RptFindFile) #IF(INSTRING(%FoundFile,%SaveFilesQueue,1,1)) #FIX(%File,%FoundFile) Print::%ReportSave::FooterFields ROUTINE #<!Print correct footer fields #SET(%Counter1,(%Counter1 + 1)) #FOR(%ReportSaveField) #! before #INSERT this group #SET(%Counter2,(%Counter2 + 1)) #SET(%BreakField,%ReportSaveField) #INSERT(%RptFindFile) #IF(INSTRING(%FoundFile,%SaveFilesQueue,1,1)) #IF(INSTRING('[',%ReportSaveField,1,1)) #!Check for array element #SET(%ArrayField,(SUB(%ReportSaveField,1,INSTRING('[',%ReportSaveField,1,1)-1))) %ReportSaveField = SAV2::%ReportSave::%ArrayField::%Counter1::%Counter2 #ELSE %ReportSaveField = SAV2::%ReportSave::%ReportSaveField #ENDIF #ENDIF #ENDFOR #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%RestoreFooterFields) #!Restore changed footer #FOR(%ReportSave) #! before #INSERT this group #IF(%ReportSave = %WhichFooter) #!Check for save file #SET(%BreakField,%ReportSave) #INSERT(%RptFindFile) #IF(INSTRING(%FoundFile,%SaveFilesQueue,1,1)) DO Restore::%ReportSave::FooterFields #<!Restore current footer fields #BREAK #ENDIF #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%RestoreFooterRoutine) #!Restore changed footer #SET(%Counter1,%NULL) #! footer field values #SET(%Counter2,%NULL) #FOR(%ReportSave) #! before #INSERT this group #SET(%BreakField,%ReportSave) #INSERT(%RptFindFile) #IF(INSTRING(%FoundFile,%SaveFilesQueue,1,1)) Restore::%ReportSave::FooterFields ROUTINE #<!Restore current footer fields #SET(%Counter1,(%Counter1 + 1)) #FOR(%ReportSaveField) #! before #INSERT this group #SET(%Counter2,(%Counter2 + 1)) #SET(%BreakField,%ReportSaveField) #INSERT(%RptFindFile) #IF(INSTRING(%FoundFile,%SaveFilesQueue,1,1)) #IF(INSTRING('[',%ReportSaveField,1,1)) #!Check for array element #SET(%ArrayField,(SUB(%ReportSaveField,1,INSTRING('[',%ReportSaveField,1,1)-1))) %ReportSaveField = SAV1::%ReportSave::%ArrayField::%Counter1::%Counter2 #ELSE %ReportSaveField = SAV1::%ReportSave::%ReportSaveField #ENDIF #ENDIF #ENDFOR #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%ReportFormulas) #!Generate formula field code #FOR(%Formula) #!%CodePosition must be set #! before #INSERT this group #IF((UPPER(LEFT(%FormulaClass)) = UPPER(%CodePosition) OR %FormulaClass = %NULL) AND %FormulaType = 'COMPUTED') %Formula = %FormulaComputation #<!%FormulaDescription #ENDIF #ENDFOR #FOR(%Formula) #!All computed fields before #IF((UPPER(LEFT(%FormulaClass)) = UPPER(%CodePosition) OR %FormulaClass = %NULL) AND %FormulaType = 'CONDITION') IF %FormulaCondition #<!%FormulaDescription %Formula = %FormulaTrue ELSE %Formula = %FormulaFalse END #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%RptRecordFilter) #!Generate record filter code #FOR(%Formula) #!%CodePosition must be set #! and must contain the file #! prefix followed by :FILTER #IF(UPPER(LEFT(%FormulaClass)) = UPPER(%CodePosition)) #IF(%FormulaType = 'COMPUTED') IF NOT (%FormulaComputation) | #<!%FormulaDescription AND NOT ErrEndFileFlag# #<!End of file? CYCLE #<!%File record filter END #ELSE IF NOT (%FormulaCondition) | #<!%FormulaDescription AND NOT ErrEndFileFlag# #<!End of file? CYCLE #<!%File record filter END #ENDIF #ENDIF #ENDFOR #!*************************************************************************** #GROUP(%GroupBreakNumber) #!Counts number of group #SET(%GroupCounter,%NULL) #! breaks on %CurrentFile #SET(%GroupFields,%NULL) #! and builds list of all the #FOR(%ReportGroup) #! break fields for the file #SET(%BreakField,%ReportGroup) #INSERT(%RptFindFile) #IF(%FoundFile = %CurrentFile) #!Check breaks on current file #SET(%GroupCounter,(%GroupCounter + 1)) #!Increment counter and add #SET(%Temp,%ReportGroup) #! field to %GroupFields list #SET(%GroupFields,(%Temp & ',' & %GroupFields)) #ENDIF #ENDFOR #!*************************************************************************** #GROUP(%PrimaryGroupBreak) #!Generates group breaks on #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ PrimaryGroupBreak │Version: 3007.105│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Generates Primary Group Break code │ #!│Called From: Report PROCEDURE │ #!│Assumptions: None │ #!│Inserts: FindGroupBreaks │ #!│ SaveFooterFields │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.105 Moved #INSERT to %SaveFooterFields to before the printing of │ #!│ Breaks. The cade was after, and caused incorrect data to print │ #!│ on Group Headers. │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #FIX(%File,%Primary) #! the %Primary file #FIX(%Key,%PrimaryKey) BreakLevel = 0 #<!Initialize group break flag #SET(%FirstCompareField,%Null) #IF(%SelectorAccess) #!If record selector #SET(%IfWritten,%Null) #!Prepare For If Structure #SET(%LastElementWritten,%Null) #FOR(%KeyField) #!For each field in key #IF(%KeyField=%KeyComponent) #SET(%CompareAgainst,%ScopeValue) #SET(%FirstCompareField,%KeyField) #ELSE #SET(%CompareAgainst,('BRK::'&%ScopeValue)) #ENDIF #IF(%IfWritten) #!If the IF statement written OR %KeyComponent <> %CompareAgainst | #<!Past Range Limits? #ELSE #!If IF not written yet IF %KeyComponent <> %CompareAgainst | #<!Past Range Limits? #ENDIF #!END (If IF Written) #IF(%FirstCompareField) #BREAK #ENDIF #SET(%IfWritten,'TRUE') #!The IF statement written #ENDFOR #!END (For Relation Field) OR ErrEndFileFlag# #<! or End of file #ELSE IF ErrEndFileFlag# #<! or End of file #ENDIF IF %FilePre::PRINTED #<!If %File Records printed BreakLevel = 1 #<! set break level to DO Print::%FilePre::GroupFooters #<! print last group footers END BREAK #<!End the report END #INSERT(%FindGroupBreaks) #IF(%ReportSaveExist) #SET(%SaveFile,%Primary) #!Check for footer save fields #INSERT(%SaveFooterFields) #ENDIF #FIX(%File,%Primary) IF NOT %FilePre::PRINTED #<!First time in? BreakLevel = 1 #<! set break level to DO Print::%FilePre::GroupHeaders #<! print first group headers %FilePre::PRINTED = 1 #<! and set recs printed flag ELSIF BreakLevel #<!Normal group break? DO Print::%FilePre::GroupFooters #<! print group footers DO Print::%FilePre::GroupHeaders #<! then group headers END #!*************************************************************************** #GROUP(%FindGroupBreaks) #! #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐ #!│ FindGroupBreaks │Version: 3007.105│ #!├──────────────────────────────┤Description├─────────────┴─────────────────┤ #!│Purpose: Find and Write Group Break code │ #!│Called From: │ #!│Assumptions: None │ #!│Inserts: None │ #!│Symbols Set: None │ #!│Notes: None │ #!├───────────────────────────────┤Comments├─────────────────────────────────┤ #!│Version Comments │ #!│──────── ────────────────────────────────────────────────────────────────│ #!│3007.000 Release of CDD3 version 3007 templates │ #!│3007.103 Repaired SAVE value restoration code (Now saves all fields up │ #!│ to and including first Report Group field) │ #!│3007.105 Repaired SAVE value restoration code (Now saves all fields up │ #!│ to and including first Report Group field) │ #!└──────────────────────────────────────────────────────────────────────────┘ #! #SET(%GroupCounter,'1') #FOR(%ReportGroup) #FIX(%Field,%ReportGroup) #IF(%Field) #SET(%IfWritten,%Null) #!Prepare For If Structure #IF(%FirstCompareField) #IF(%FirstCompareField=%Field) #SET(%BeginWriting,'TRUE') #ELSE #SET(%BeginWriting,%Null) #ENDIF #ELSE #SET(%BeginWriting,'TRUE') #ENDIF #FOR(%KeyField) #IF(%BeginWriting) #IF(UPPER(%KeyField)=UPPER(%ReportGroup))#!If this is last link field #IF(%IfWritten) #!If the IF statement written OR BRK::%KeyField <> %KeyField #<!Past Range Limits? #ELSE #!If IF not written yet #IF(%GroupCounter<>'1') ELSIF BRK::%KeyField <> %KeyField #<!Past Range Limits? #ELSE IF BRK::%KeyField <> %KeyField #<!Past Range Limits? #ENDIF #SET(%IfWritten,'TRUE') #!The IF statement written #ENDIF #!END (If IF Written) #BREAK #!Break out of loop #ELSE #!otherwise (Counter > 1) #IF(%IfWritten) #!If the IF statement written OR BRK::%KeyField <> %KeyField | #<!Past Range Limits? #ELSE #!If IF not written yet #IF(%GroupCounter<>'1') ELSIF BRK::%KeyField <>%KeyField | #<!Past Range Limits? #ELSE IF BRK::%KeyField <> %KeyField | #<!Past Range Limits? #ENDIF #SET(%IfWritten,'TRUE') #!The IF statement written #ENDIF #!END (If IF Written) #ENDIF #!END (If Field Counter = 1) #ELSIF(%KeyField=%FirstCompareField) #SET(%BeginWriting,'True') #ENDIF #IF(UPPER(%KeyField)=UPPER(%ReportGroup)) #BREAK #ENDIF #ENDFOR #IF(%IfWritten) BreakLevel = %GroupCounter #SET(%GroupCounter,(%GroupCounter+1)) #SET(%FirstCompareField,%ReportGroup) #ENDIF #ENDIF #ENDFOR END IF BreakLevel #SET(%LastBreak,%Null) #FOR(%ReportGroup) #FIX(%Field,%ReportGroup) #IF(%Field) #SET(%LastBreak,%Field) #ENDIF #ENDFOR #FIX(%File,%BreakFile) #FOR(%KeyField) #IF(%KeyField=%LastBreak) #SET(%EndWriting,'TRUE') #ENDIF BRK::%KeyField = %KeyField #<!Past Range Limits? #IF(%EndWriting) #BREAK #ENDIF #ENDFOR END #!*************************************************************************** #GROUP(%SecondaryGroupBreak) #!For Secondary files only BreakLevel = 0 #<!Initialize group break flag #FIX(%File,%Parent) #FIX(%Relation,%Secondary) #SET(%IfWritten,%Null) #SET(%FirstCompareField,%Null) #FOR(%RelationKeyField) #! and build the code #IF(%RelationKeyFieldLink) #SET(%FirstCompareField,%RelationKeyField) #IF(%IfWritten) OR %RelationKeyField <> %RelationKeyFieldLink |#<!Past related records? #ELSE IF %RelationKeyField <> %RelationKeyFieldLink |#<!Past related records? #ENDIF #SET(%IfWritten,'TRUE') #ENDIF #ENDFOR #IF(%IfWritten) OR ErrEndFileFlag# #<! or end of file? #ELSE IF ErrEndFileFlag# #<! or end of file? #ENDIF IF %RelationPre::PRINTED #<!If %File Records printed BreakLevel = 1 #<! set max break level to DO Print::%RelationPre::GroupFooters #<! print last group footers END BREAK #<!End %File file processing END #SET(%ProcessingKey,%RelationKey) #FIX(%File,%Relation) #FIX(%Key,%ProcessingKey) #INSERT(%FindGroupBreaks) IF NOT %RelationPre::PRINTED #<!First time in? BreakLevel = 1 #<! set break level to #SET(%LastProcessingField,%Null) #FIX(%File,%Secondary) #FOR(%ReportGroup) #FIX(%Field,%ReportGroup) #IF(%Field) #SET(%LastProcessingField,%Field) #ENDIF #ENDFOR #SET(%BeginWriting,%Null) #FIX(%Key,%ProcessingKey) #FOR(%RelationKeyField) #IF(%RelationKeyFieldLink=%Null) BRK::%RelationKeyField = %RelationKeyField #<!Save new break values #ENDIF #IF(%RelationKeyField=%LastProcessingField) #BREAK #ENDIF #ENDFOR DO Print::%RelationPre::GroupHeaders #<! print first group headers %RelationPre::PRINTED = 1 #<! and set recs printed flag ELSIF BreakLevel DO Print::%RelationPre::GroupFooters #<! print group footers DO Print::%RelationPre::GroupHeaders #<! then group headers END #! #!*************************************************************************** #GROUP(%BreakFooterRoutines) #!Build ROUTINES to print footers #SET(%TempFiles,%BreakFilesQueue) #!Work through all files with #FOR(%ReportGroup) #! group breaks on them #SET(%Temp1,(SUB(%TempFiles,1,INSTRING(',',%TempFiles,1,1)-1))) #SET(%TempFiles,(SUB(%TempFiles,LEN(%Temp1)+2,LEN(%TempFiles)-LEN(%Temp1)+1))) #IF(NOT %Temp1) #!No files left in queue? #BREAK #! end process #ENDIF #SET(%CurrentFile,%Temp1) #!Set up to get break fields #INSERT(%GroupBreakNumber) #! and count them #FIX(%File,%Temp1) #!Set up to work through #IF(%Primary = %File) #! %KeyField for all code #FIX(%Key,%PrimaryKey) #ELSE #FIX(%Secondary,%File) #FIX(%File,%SecondaryTo) #FIX(%Relation,%Secondary) #SET(%TempKey,%RelationKey) #FIX(%File,%Secondary) #FIX(%Key,%TempKey) #ENDIF Print::%FilePre::GroupFooters ROUTINE #<!Group Footers for %File file #IF(%ReportLabel) #!Check for labels with breaks #INSERT(%PrintDanglingLabels) #ENDIF #SET(%BreakCounter,%GroupCounter) #SET(%TempGroup,%GroupFields) #FOR(%KeyField) #SET(%Temp,(SUB(%TempGroup,1,INSTRING(',',%TempGroup,1,1)-1))) #SET(%TempGroup,(SUB(%TempGroup,LEN(%Temp)+2,LEN(%TempGroup)-LEN(%Temp)+1))) #FIX(%ReportGroup,%Temp) #IF(%ReportGroup <> %NULL) IF BreakLevel <= %BreakCounter #<!Check group break level #INSERT(%GroupBreakFooter) END #ENDIF #SET(%BreakCounter,(%BreakCounter - 1)) #IF(NOT %BreakCounter) #BREAK #ENDIF #ENDFOR #ENDFOR #! #!*************************************************************************** #GROUP(%BreakHeaderRoutines) #!Build ROUTINES to print headers #SET(%TempFiles,%BreakFilesQueue) #!Work through all files with #FOR(%ReportGroup) #! group breaks on them #SET(%Temp1,(SUB(%TempFiles,1,INSTRING(',',%TempFiles,1,1)-1))) #SET(%TempFiles,(SUB(%TempFiles,LEN(%Temp1)+2,LEN(%TempFiles)-LEN(%Temp1)+1))) #IF(NOT %Temp1) #!No files left in queue? #BREAK #! end process #ENDIF #SET(%CurrentFile,%Temp1) #!Set up to get break fields #INSERT(%GroupBreakNumber) #! and count them #FIX(%File,%Temp1) #!Set up to work through #IF(%Primary = %File) #! %KeyField for all code #FIX(%Key,%PrimaryKey) #ELSE #FIX(%Secondary,%File) #FIX(%File,%SecondaryTo) #FIX(%Relation,%Secondary) #SET(%TempKey,%RelationKey) #FIX(%File,%Secondary) #FIX(%Key,%TempKey) #ENDIF Print::%FilePre::GroupHeaders ROUTINE #<!Group Headers for %File file #SET(%BreakCounter,'1') #!Check for labels with breaks #FOR(%KeyField) #IF(INSTRING(%KeyField,%GroupFields,1,1)) #FIX(%ReportGroup,%KeyField) IF BreakLevel <= %BreakCounter #<!Check group break level #INSERT(%GroupBreakHeader) END #IF(%BreakCounter = %GroupCounter) #BREAK #ENDIF #SET(%BreakCounter,(%BreakCounter + 1)) #ENDIF #ENDFOR #ENDFOR #! #!*************************************************************************** #GROUP(%GroupBreakFooter) #!PRINT group footers #SET(%ThisReportGroup,%ReportGroup) #!Save work Group #IF(%ReportSaveExist) #SET(%WhichFooter,%ThisReportGroup) #!Ensure footer fields contain #INSERT(%PrintFooterFields) #! correct values to print #ENDIF #FIX(%ReportGroup,%ThisReportGroup) #!Fix to saved work Group #SET(%CodePosition,%ThisReportGroup) #!Class = group break field #INSERT(%ReportFormulas) #!Generate formulas #FIX(%ReportGroup,%ThisReportGroup) #!Fix to saved work Group #IF(%ReportGroupFooterPre) %ReportGroupFooterPre #ENDIF #IF(%ReportGroupFooter) PRINT(%ReportPre:%ReportGroupFooter) #<!Print group footer #IF(%ProgressScreen) DISPLAY #<!Display report progress #ENDIF #ENDIF #IF(%ReportGroupFooterPost) %ReportGroupFooterPost #ENDIF #IF(%ReportSaveExist) #SET(%WhichFooter,%ThisReportGroup) #!Ensure footer fields contain #INSERT(%RestoreFooterFields) #!Restore saved footer fields #ENDIF #IF(%PageTotals) #!Any footer save fields? IF SAV::LineCounter > %ReportLine #<!Page overflow? #SET(%ResetTotalType,'PAGE') #!Reset page totals #INSERT(%ResetTotals) #SET(%TallyType,'PAGE') #!Tally page totals #INSERT(%TallyTotals) END SAV::LineCounter = %ReportLine #<!Save line counter #ENDIF #SET(%TallyType,%ThisReportGroup) #!Tally group total fields #INSERT(%TallyTotals) #SET(%ResetTotalType,%ThisReportGroup) #!Reset group total fields #INSERT(%ResetTotals) #! #!*************************************************************************** #GROUP(%GroupBreakHeader) #!PRINT group header #SET(%ThisReportGroup,%ReportGroup) #!Save work Group #IF(%ReportGroupHeaderPre) %ReportGroupHeaderPre #ENDIF #IF(%ReportGroupHeader) PRINT(%ReportPre:%ReportGroupHeader) #<!Print group header #IF(%ProgressScreen) DISPLAY #<!Display report progress #ENDIF #ENDIF #IF(%ReportGroupHeaderPost) %ReportGroupHeaderPost #ENDIF #IF(%PageTotals) #!Any footer save fields? IF SAV::LineCounter > %ReportLine #<!Page overflow? #SET(%ResetTotalType,'PAGE') #!Reset page totals #INSERT(%ResetTotals) #SET(%TallyType,'PAGE') #!Tally page totals #INSERT(%TallyTotals) END SAV::LineCounter = %ReportLine #<!Save line counter #ENDIF #! #!*************************************************************************** #GROUP(%MultiUpLabelBuild) SAV::LabelCounter += 1 #<!Increment label counter #SET(%Counter1,%NULL) #FOR(%ReportLabelField) #SET(%Counter1,(%Counter1 + 1)) #IF(INSTRING('[',%ReportLabelField,1,1)) #!Check for array element #SET(%ArrayField,(SUB(%ReportLabelField,1,INSTRING('[',%ReportLabelField,1,1)-1))) LBL::%ArrayField::%Counter1[SAV::LabelCounter] = %ReportLabelField #ELSE LBL::%ReportLabelField[SAV::LabelCounter] = %ReportLabelField #ENDIF #ENDFOR IF SAV::LabelCounter < %ReportLabel CYCLE END #! #!*************************************************************************** #GROUP(%MultiUpLabelReset) SAV::LabelCounter = 0 #<!Reset label counter #SET(%Counter1,%NULL) #FOR(%ReportLabelField) #SET(%Counter1,(%Counter1 + 1)) #IF(INSTRING('[',%ReportLabelField,1,1)) #!Check for array element #SET(%ArrayField,(SUB(%ReportLabelField,1,INSTRING('[',%ReportLabelField,1,1)-1))) CLEAR(LBL::%ArrayField::%Counter1) #<!Reset label USE variable #ELSE CLEAR(LBL::%ReportLabelField) #<!Reset label USE variable #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%PrintDanglingLabels) IF SAV::LabelCounter <> 0 #<!If any labels left to print #IF(%ReportDetailPre) %ReportDetailPre #ENDIF PRINT(%ReportPre:%ReportDetail) #<!Print last line item detail #IF(%ProgressScreen) DISPLAY #<!Display report progress #ENDIF #IF(%ReportDetailPost) %ReportDetailPost #ENDIF #INSERT(%MultiUpLabelReset) END #!*************************************************************************** #GROUP(%RptAbortKey) #IF(%EscapeAbort) #!Enable ESC checked? LOOP WHILE KEYBOARD() #<!If any keystrokes waiting ASK #<! in the buffer, get them IF KEYCODE() = EscKey #<!Detect the ESC key DO ProcedureReturn END END #<!End abort key loop #ENDIF #! #!*************************************************************************** #GROUP(%RptSetFlags) #!Generation Condition flags #SET(%SelectorAccess,(%AccessMethod = 'Keyed Order' AND %KeyComponent <> %NULL)) #FOR(%Secondary) #!Are there secondary files? #SET(%SecondaryExist,'YES') #BREAK #ENDFOR #FOR(%Formula) #!Are there Formulas? #SET(%FormulaExist,'YES') #BREAK #ENDFOR #FOR(%ReportGroup) #!Build queue of files that #SET(%BreakField,%ReportGroup) #! have group breaks #INSERT(%RptFindFile) #SET(%Temp,%FoundFile) #IF(NOT INSTRING(%Temp,%BreakFilesQueue,1,1)) #SET(%BreakFilesQueue,(%BreakFilesQueue & %Temp & ',')) #ENDIF #SET(%ReportGroupExist,'YES') #ENDFOR #FOR(%ReportTotal) #!Are there Totals? #SET(%ReportTotalExist,'YES') #BREAK #ENDFOR #SET(%SaveFilesQueue,%NULL) #FOR(%ReportSave) #!Build list of files that #SET(%BreakField,%ReportSave) #! have footers with fields #INSERT(%RptFindFile) #! from that file or are #SET(%BreakFile,%FoundFile) #! looked up from that file #FOR(%ReportSaveField) #SET(%BreakField,%ReportSaveField) #INSERT(%RptFindFile) #FIX(%Secondary,%FoundFile) #IF(%BreakFile = %FoundFile) #SET(%ReportSaveExist,'YES') #!Set Flag #SET(%Temp,%FoundFile) #IF(NOT INSTRING(%Temp,%SaveFilesQueue,1,1)) #SET(%SaveFilesQueue,(%SaveFilesQueue & %Temp & ',')) #ENDIF #ELSIF(%SecondaryTo = %BreakFile AND %SecondaryType = 'MANY:1') #SET(%ReportSaveExist,'YES') #!Set flag #SET(%Temp,%FoundFile) #IF(NOT INSTRING(%Temp,%SaveFilesQueue,1,1)) #SET(%SaveFilesQueue,(%SaveFilesQueue & %Temp & ',')) #ENDIF #ENDIF #ENDFOR #ENDFOR #FOR(%ReportTotal) #!Detect any PAGE total fields #IF(%ReportTotalReset = 'PAGE') #SET(%PageTotals,'YES') #!Set flag #BREAK #ELSIF(%ReportTotalTally = 'PAGE') #SET(%PageTotals,'YES') #!Set flag #BREAK #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%RptFindFile) #!Find file from field prefix #SET(%FoundFile,%NULL) #FOR(%File) #IF(UPPER(%FilePre) = UPPER(SUB(%BreakField,1,INSTRING(':',%BreakField,1,1)-1))) #SET(%FoundFile,%File) #BREAK #ENDIF #ENDFOR #! #!*************************************************************************** #GROUP(%ReportErrorCheck) #SET(%ErrorMessage,(%Procedure & ' ERROR:')) #IF(%Primary = %NULL) #!No File Schematic? #ERROR(%ErrorMessage) #ERROR(' You MUST define a Primary File in the File Schematic.') #ENDIF #IF(%KeyComponent) #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #FOR(%KeyField) #IF(%KeyField = %KeyComponent) #SET(%FoundComponent,'YES') #BREAK #ENDIF #ENDFOR #IF(%FoundComponent = %NULL) #!Range limit on wrong Key? #ERROR(%ErrorMessage) #ERROR(' Range Limit Field must be a component of ') #ERROR(' the Primary file Access Key.') #ENDIF #IF(%ScopeValue = %NULL) #!Range limit w/o Range Value #ERROR(%ErrorMessage) #ERROR(' Must define a Range Value Field') #ELSIF(%KeyComponent = %ScopeValue) #!Range limit == Range Value #ERROR(%ErrorMessage) #ERROR(' Range Value Field and Range Limit Field') #ERROR(' must be separate fields.') #ENDIF #ENDIF #! #CHAIN('Warnings.TPX')